home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / stay42.zip / STAYSUBS.420 < prev    next >
Text File  |  1986-08-06  |  17KB  |  401 lines
  1. {****************************************************************************}
  2. {                         S T A Y S U B S  .  I N C                          }
  3. {****************************************************************************}
  4.       {---------------------------------------------------------}
  5.       {            S E T U P   I N T E R R U P T                }
  6.       {---------------------------------------------------------}{
  7. {        Msg # *48   Dated 07-07-86 16:54:36
  8.          From: NEIL RUBENKING
  9.          To: LANE FERRIS
  10.          Re: STAY, WON'T YOU?
  11.  
  12.          Lane,
  13.               Here's what I did:
  14. }
  15.   PROCEDURE Setup_Interrupt(IntNo :byte; VAR IntVec :vector; offset :integer);
  16.   BEGIN
  17.     Regs.Ax := $3500 + IntNo;
  18.     Intr(DosI21,Regs);            {get the address of interrupt }
  19.     IntVec.IP := Regs.BX;            { Location of Interrupt Ip }
  20.     IntVec.CS := Regs.Es;            { Location of Interrupt Cs }
  21.  
  22.     Regs.Ax := $2500 + IntNo;     { set the interrupt to point to}
  23.     Regs.Ds := Cseg;              {  our procedure}
  24.     Regs.Dx := Offset;
  25.     Intr (DosI21,Regs);
  26.   END;
  27. (******************* C O M M E N T *****************************************
  28. {in the main part of the program}
  29.       Setup_Interrupt(BIOSI16, BIOS_Int16, Ofs(Stay_INT16)); {keyboard}
  30.       Setup_Interrupt(BIOSI10, BIOS_Int10, Ofs(Stay_INT10)); {video}
  31.       Setup_Interrupt(BIOSI8, BIOS_Int8, Ofs(Stay_INT8));    {timer}
  32.       Setup_Interrupt(BIOSI13, BIOS_Int13, Ofs(Stay_INT13)); {disk}
  33.       Setup_Interrupt(DOSI21, DOS_Int21, Ofs(Stay_INT21));   {DOSfunction}
  34.       Setup_Interrupt(DOSI28, DOS_Int28, Ofs(Stay_INT28));   {DOS idle}
  35. ********************* C O M M E N T *****************************************)
  36.       {---------------------------------------------------------}
  37.       {                 S E  T    D  T  A                       }
  38.       {---------------------------------------------------------}
  39.    Procedure SetDTA(var segment, offset : integer );
  40.    BEGIN
  41.      regs.ax := $1A00;      { Function used to get current DTA address }
  42.      regs.Ds := segment;    { Segment of DTA returned by DOS }
  43.      regs.Dx := offset;     { Offset of DTA returned }
  44.      MSDos( regs );         { Execute MSDos function request }
  45.    END;
  46.       {---------------------------------------------------------}
  47.       {                 G E  T    D  T  A                       }
  48.       {---------------------------------------------------------}
  49.    Procedure GetDTA(var segment, offset : integer );
  50.    BEGIN
  51.      regs.ax := $2F00;      { Function used to get current DTA address }
  52.      MSDos( regs );         { Execute MSDos function request }
  53.      segment := regs.ES;    { Segment of DTA returned by DOS }
  54.      offset  := regs.Bx;    { Offset of DTA returned }
  55.    END;
  56.       {---------------------------------------------------------}
  57.       {                 S E  T    P  S  P                       }
  58.       {---------------------------------------------------------}
  59.    Procedure SetPSP(var segment : integer );
  60.    BEGIN
  61.  
  62.        { A bug in DOS 2.0, 2.1, causes DOS to clobber its standard stack   }
  63.        { when the PSP get/set functions are issued at the DOS prompt. The  }
  64.        { following checks are made, forcing DOS to use the "critical"      }
  65.        { stack when the TSR enters at the INDOS level.                     }
  66.  
  67.                                       {If Version less then 3.0 and INDOS set }
  68.    If DosVersion < 3 then             { then set the Dos Critical Flag        }
  69.       If Mem[DosStat1.CS:DosStat1.IP] <> 0 then
  70.           Mem[DosStat2.CS:DosStat2.IP] := $FF;
  71.  
  72.      regs.ax := $5000;      { Function to set current PSP address }
  73.      regs.bx := segment;    { Segment of PSP to be used by DOS }
  74.      MSDos( regs );         { Execute MSDos function request }
  75.  
  76.                                       {If Version less then 3.0 and INDOS set }
  77.      If DosVersion < 3 then           { then clear the Dos Critical Flag     }
  78.         If Mem[DosStat1.CS:DosStat1.IP] <> 0 then
  79.            Mem[DosStat2.CS:DosStat2.IP] := $00;
  80.  
  81.    END;
  82.       {---------------------------------------------------------}
  83.       {                 G E  T    P  S  P                       }
  84.       {---------------------------------------------------------}
  85.    Procedure GetPSP(var segment : integer );
  86.    BEGIN
  87.  
  88.        { A bug in DOS 2.0, 2.1, causes DOS to clobber its standard stack   }
  89.        { when the PSP get/set functions are issued at the DOS prompt. The  }
  90.        { following checks are made, forcing DOS to use the "critical"      }
  91.        { stack when the TSR enters at the INDOS level.                     }
  92.  
  93.                                {If Version less then 3.0 and INDOS set }
  94.    If DosVersion < 3 then      { then set the Dos Critical Flag        }
  95.       If Mem[DosStat1.CS:DosStat1.IP] <> 0 then
  96.           Mem[DosStat2.CS:DosStat2.IP] := $FF;
  97.  
  98.      regs.ax := $5100;      { Function to get current PSP address }
  99.      MSDos( regs );         { Execute MSDos function request }
  100.      segment := regs.Bx;    { Segment of PSP returned by DOS }
  101.  
  102.                                 {IF DOS Version less then 3.0 and INDOS set }
  103.    If DosVersion < 3 then       { then clear the Dos Critical Flag     }
  104.       If Mem[DosStat1.CS:DosStat1.IP] <> 0 then
  105.            Mem[DosStat2.CS:DosStat2.IP] := $00;
  106.  
  107.    END;
  108.     {---------------------------------------------------------------}
  109.     {        G e t   C o n t r o l  C (break)  V e c t o r          }
  110.     {---------------------------------------------------------------}
  111. Type
  112.     Arrayparam = array [1..2] of integer;
  113. Const
  114.      SavedCtlC: arrayparam = (0,0);
  115.      NewCtlC  : arrayparam = (0,0);
  116.  Procedure GetCtlC(Var SavedCtlC:arrayparam);
  117.     Begin                     {Record the Current Ctrl-C Vector}
  118.        With Regs Do
  119.        Begin
  120.        AX:=$3523;
  121.        MsDos(Regs);
  122.        SavedCtlC[1]:=BX;
  123.        SavedCtlC[2]:=ES;
  124.        End;
  125.     End;
  126.     {---------------------------------------------------------------}
  127.     {        S e t   C o n t r o l  C   V e c t o r                 }
  128.     {---------------------------------------------------------------}
  129.     Procedure IRET;          {Dummy Ctrl-C routine}
  130.        Begin
  131.        inline($5D/$5D/$CF);  {Pop Bp/Pop Bp/Iret}
  132.        end;
  133.  Procedure SetCtlC(Var CtlCptr:arrayparam);
  134.     Begin                     {Set the New Ctrl-C Vector}
  135.        With Regs Do
  136.        Begin
  137.         AX:=$2523;
  138.         DS:=CtlCptr[2];
  139.         DX:=CtlCptr[1];
  140.         MsDos(Regs);
  141.        End;
  142.     End;
  143. {----------------------------------------------------------------------}
  144. {           K e y i n   :   R e a d  K e a b o a r d                   }
  145. {----------------------------------------------------------------------}
  146. Function Keyin: char;          { Get a key from the Keyboard           }
  147.    Var Ch : char;              { If extended key, fold above 127       }
  148.    Begin                       {---------------------------------------}
  149.       Repeat until Keypressed;
  150.       Read(Kbd,Ch);
  151.       if (Ch = Esc) and KeyPressed then
  152.          Begin
  153.          Read(Kbd,Ch);
  154.          Ch := Char(Ord(Ch) + 127);
  155.          End;
  156.       Keyin := Ch;
  157.    End;  {Keyin}
  158. {----------------------------------------------------------------------}
  159. {          B e e p   :  S o u n d  t h e  H o r n                      }
  160. {----------------------------------------------------------------------}
  161. Procedure Beep(N :integer); {------------------------------------------}
  162.    Begin                    {  This routine sounds a tone of frequency }
  163.       Sound(n);             {  N for approximately 100 ms              }
  164.       Delay(100);           {------------------------------------------}
  165.       Sound(n div 2);
  166.       Delay(100);
  167.       Nosound;
  168.       End {Beep} ;
  169.  
  170.       {--------------------------------------------------------------}
  171.       {                I N T E R R U P T    2 4                      }
  172.       {--------------------------------------------------------------}
  173. { Version 2.0, 1/28/86
  174.   -  Bela Lubkin
  175.      CompuServe 76703,3015
  176.  
  177.      Apologetically mangle